На главную Наши проекты:
Журнал   ·   Discuz!ML   ·   Wiki   ·   DRKB   ·   Помощь проекту
ПРАВИЛА FAQ Помощь Участники Календарь Избранное RSS
msm.ru
! ПРАВИЛА РАЗДЕЛА · FAQ раздела Delphi · Книги по Delphi
Пожалуйста, выделяйте текст программы тегом [сode=pas] ... [/сode]. Для этого используйте кнопку [code=pas] в форме ответа или комбобокс, если нужно вставить код на языке, отличном от Дельфи/Паскаля.
Следующие вопросы задаются очень часто, подробно разобраны в FAQ и, поэтому, будут безжалостно удаляться:
1. Преобразовать переменную типа String в тип PChar (PAnsiChar)
2. Как "свернуть" программу в трей.
3. Как "скрыться" от Ctrl + Alt + Del (заблокировать их и т.п.)
4. Как прочитать список файлов, поддиректорий в директории?
5. Как запустить программу/файл?
... (продолжение следует) ...

Вопросы, подробно описанные во встроенной справочной системе Delphi, не несут полезной тематической нагрузки, поэтому будут удаляться.
Запрещается создавать темы с просьбой выполнить какую-то работу за автора темы. Форум является средством общения и общего поиска решения. Вашу работу за Вас никто выполнять не будет.


Внимание
Попытки открытия обсуждений реализации вредоносного ПО, включая различные интерпретации спам-ботов, наказывается предупреждением на 30 дней.
Повторная попытка - 60 дней. Последующие попытки бан.
Мат в разделе - бан на три месяца...
Модераторы: jack128, D[u]fa, Shaggy, Rouse_
Страницы: (2) [1] 2  все  ( Перейти к последнему сообщению )  
> Почему не устанавливается компонент? , проблема установки собстевенного крмпонента...
    На днях писал компонент, для чата с поддержкой цветов и смайликов, и столкнулся с такой проблеммой: компонент откомпилировался, а устанавливаться не хочет <_< . Если кто-нибудь знает в чем тут проблема, объясните плиз!

    Вот код:

    ExpandedWrap disabled
       
      unit ChatEdit;
       
      interface
       
      uses Controls, Types, SysUtils, Graphics, Classes, Forms, StdCtrls, ExtCtrls;
       
      const
        NRSMILIES = 35;
        SMILESIZE = 20;
        SmileCodes:array[0..NRSMILIES-1]of string[4]=
        ('8-|', ':-/', ':O', '>:)', '0:)', ':-&', '(:|', '8-}',
        ':x', 'X-(', ':((', ':-B', ':-$', '=P~', '=D>', ':\">', ':>', ':))',
        '=;', '[-(', ':-?', ':D', ':p', 'B-)', ':|', 'I-)', ':o)', '#-o', ';)o', ':-*', ':-S', '/:)', ':)', ':(', ';)');
       
      type
      TChatEdit = class(TPaintBox)
      protected
        FLines : TStringList;
        DisplayLines : TStringList;
        FFont : TFont;
        FScrollBar : TScrollBar;
        FBkColor,FTextColor1,FTextColor2,FTextColor3,FTextColor4,FTextColor5: TColor;
        FPosition : word;
        FNrLines : integer;
        Smilies : TBitmap;
        FSmiliesFile: string;
        procedure Paint; override;
        procedure SetBkColor(nc:TColor);
        procedure SetTextColor1(nc:TColor);
        procedure SetTextColor2(nc:TColor);
        procedure SetTextColor3(nc:TColor);
        procedure SetTextColor4(nc:TColor);
        procedure SetTextColor5(nc:TColor);
        procedure SetFont(nf : TFont);
        procedure SetPosition(np : Word);
        function GetNrLines : integer;
        procedure ResetCanvas;
        procedure SetScrollBar(ns : TScrollBar);
        procedure Loaded; override;
        procedure ProcessDisplay;
      public
          constructor Create(AOwner : TComponent); override;
          destructor destroy; override;
          procedure AddLines(value : TStringList);
          procedure AddLine(ns: String);
          procedure Clear;
          procedure LoadSmilies;
          function TextWidth(s : string):integer;
       published
          property ScrollBar : TScrollBar read FScrollBar write SetScrollBar default nil;
          property NrLines : integer read GetNrLines;
          property Font: TFont read FFont write SetFont;
          property Position : Word read FPosition write SetPosition;
          property BkColor:TColor read FBkColor write SetBkColor;
          property TextColor1:TColor read FTextColor1 write SetTextColor1;
          property TextColor2:TColor read FTextColor2 write SetTextColor2;
          property TextColor3:TColor read FTextColor3 write SetTextColor3;
          property TextColor4:TColor read FTextColor4 write SetTextColor4;
          property TextColor5:TColor read FTextColor5 write SetTextColor5;
          property SmiliesFile : string read FSmiliesFile write FSmiliesFile;
      end;
       
      procedure register;
       
       
      implementation
       
      {$R *.res}
       
      procedure Register;
      begin
        RegisterComponents('Chat', [TChatEdit]);
      end;
       
       
      //.............Constructor..........................
      Constructor TChatEdit.Create(AOwner : TComponent);
      begin
      inherited Create(aOwner);
      FLines := TStringList.Create;
      DisplayLines:=TStringList.Create;
      FFont:=TFont.Create;
      Canvas.Font:=FFont;
      Smilies:=TBitmap.Create;
      FPosition:=0;
      FScrollBar:=nil;
      FBkColor:=clWhite;
      FTextColor1:=clBlack;
      FTextColor2:=clBlack;
      FTextColor3:=clBlack;
      FTextColor4:=clBlack;
      FTextColor5:=clBlack;
      end;
       
      // ---------------  destructor ---------
      destructor TChatEdit.destroy;
      begin
       FLines.free;
       DisplayLines.free;
       FFont.Free;
       Smilies.free;
       inherited;
      end;
       
      //..............Loads the smilies from a bitmap ....
      procedure TChatEdit.LoadSmilies;
      begin
      if FileExists(FSmiliesFile) then Smilies.LoadFromFile(FSmiliesFile);
      Smilies.TransparentMode:=tmAuto;
      Smilies.Transparent:=true;
      end;
       
      //..............Calculates the text width considering smiles...
      function TChatEdit.TextWidth(s : string):integer;
      var
       t,temp : string;
       nrsml, sml : integer;
       j : integer;
      begin
      t:=s;
      nrsml:=0;
        for  j:=0 to NRSMILIES-1 do//finds first smile pos
        begin
        temp:=SmileCodes[j];
        sml:=Pos(temp,t);
        while sml<>0 do
          begin
           inc(nrsml);
           Delete(t,sml,length(temp));
           sml:=Pos(temp,t)
          end;
        end;
      result:=Canvas.TextWidth(t)+SMILESIZE*nrsml;
      end;
       
      //..............Processes the lines to display ....
      procedure TChatEdit.ProcessDisplay;
      var
        y, i, nl, p, q : integer;
        Line,DLine,t : string;
        revers : TStringList;
      begin
        i:=position-1;
        nl:=0;
        revers := TStringList.Create;
        revers.Clear;
        DisplayLines.Clear;
       
      while (nl<NrLines)and(i>=0) do
       begin
        Line:=FLines.Strings[i];
       
         if TextWidth(Line)>Width then
          begin
            Delete(Line,1,1);
            revers.Clear;
            while Length(Line)>0 do
             begin
                    p:=1;
                    while (TextWidth(copy(Line,1,p))<Width-3)and(p<Length(Line)) do inc(p);
                    if p>=Length(Line)  then DLine:=copy(Line,1,p)
                 else
                    begin
                     DLine:=copy(Line,1,p-1);
                      q:=0;
                      q:=LastDelimiter(' ',DLine);
                      if q>0 then Delete(DLine,q+1,Length(DLine)-q);
                    end;
             Delete(Line, 1,Length(DLine));
             t:=FLines.Strings[i][1];
             DLine:=t+DLine;
             inc(nl);
             revers.Add(DLine);
             end;
            for y:=revers.Count-1 downto 0 do DisplayLines.Add(revers.Strings[y]);
          end
         else
          begin
          DisplayLines.Add(Line);
          inc(nl);
          end;
       dec(i);
       end;
      revers.free;
      end;
       
      //...............Loaded..............
      procedure TChatEdit.Loaded;
      begin
      ResetCanvas;
      Canvas.Font.Assign(FFont);
      if FileExists(FSmiliesFile) then Smilies.LoadFromFile(FSmiliesFile)
             else Application.MessageBox('Smilies file not found','Error',0);
       
      Smilies.TransparentMode:=tmAuto;
      Smilies.Transparent:=true;
      Position:=1;
      inherited Loaded;
      end;
       
      //.................ResetCanvas........................
      procedure TChatEdit.ResetCanvas;
      begin
      Canvas.Brush.Style:=bsSolid;
      Canvas.Brush.Color:=clWindow;
      Canvas.Pen.Color:=clBlack;
      Canvas.Pen.Mode:=pmCopy;
      Canvas.Pen.Style:=psSolid;
      end;
       
      //............Clears the chat text....................
      procedure TChatEdit.Clear;
      begin
      FLines.Clear;
      Position:=0;
      end;
       
      //...........Add Lines................................
      procedure TChatEdit.AddLines(Value : TStringList);
      begin
      if (Value=nil)or(Value.Count=0) then exit;
       
      FLines.AddStrings(Value);
      FPosition:=FLines.Count;
      if FScrollBar<>nil then
       begin
       FScrollBar.Max:=FLines.Count-1;
       FScrollBar.Position:=FPosition;
       end;
      ProcessDisplay;
      Repaint;
      end;
       
      //...........AddLine Lines................................
      procedure TChatEdit.AddLine(ns : string);
       begin
        FLines.Add(ns);
        FPosition:=FLines.Count;
        if FScrollBar<>nil then
         begin
           FScrollBar.Max:=FLines.Count-1;
           FScrollBar.Position:=FPosition;
         end;
        ProcessDisplay;
        Repaint;
      end;
       
      //..................SetPosition.....................
      procedure TChatEdit.SetPosition(np : word);
      begin
      if FPosition=np then exit;
      if np>FLines.Count then np:=FLines.Count;
      FPosition:=np;
      ProcessDisplay;
      Repaint;
      end;
       
      //...........SetFont..............................
      procedure TChatEdit.SetFont(NF : TFont);
      begin
      FFont.Assign(NF);
      Canvas.Font:=FFont;
      Repaint;
      end;
       
      //.................GetNrLines......................
      function TChatEdit.GetNrLines : integer;
      begin
      if ClientHeight/Canvas.TextHeight('T')>SMILESIZE then FNrLines:=Canvas.TextHeight('T') else FNrLines:=SMILESIZE;
      result:=FNrLines;
      end;
       
      //...........SetScrollBar.............................
      procedure TChatEdit.SetScrollBar(ns : TScrollBar);
      begin
      FScrollBar:=ns;
      FScrollBar.Max:=NrLines;
      FScrollBar.Min:=0;
      FScrollBar.Kind:=sbVertical;
      FScrollBar.Left:=Left+Width;
      FScrollBar.Top:=Top;
      FScrollBar.Height:=Height;
      FScrollBar.LargeChange:=NrLines;
      FScrollBar.SmallChange:=1;
      end;
       
      //.................SetBkColor.....................
      procedure TChatEdit.SetBkColor(nc: TColor);
      begin
      FBkColor:=nc;
      Repaint;
      end;
       
      //.................SetTextColor1.....................
      procedure TChatEdit.SetTextColor1(nc: TColor);
      begin
      FTextColor1:=nc;
      Repaint;
      end;
       
      //.................SetTextColor2.....................
      procedure TChatEdit.SetTextColor2(nc: TColor);
      begin
      FTextColor2:=nc;
      Repaint;
      end;
       
      //.................SetTextColor3.....................
      procedure TChatEdit.SetTextColor3(nc: TColor);
      begin
      FTextColor3:=nc;
      Repaint;
      end;
       
      //.................SetTextColor4.....................
      procedure TChatEdit.SetTextColor4(nc: TColor);
      begin
      FTextColor4:=nc;
      Repaint;
      end;
       
      //.................SetTextColor5.....................
      procedure TChatEdit.SetTextColor5(nc: TColor);
      begin
      FTextColor5:=nc;
      Repaint;
      end;
       
      //...........Paint................................
      procedure TChatEdit.Paint;
      var
        j,i, minsml, textheight, smilenr : integer;
        offscreen : TBitmap;
        Cursory,Cursorx : integer;  //y position of the text being displayed
        smilepos:array[0..100] of integer;
        smiletype:array[0..100] of integer;
        temp,line:string;
        k,sml,tip : integer;//first smile,curent smile,smile type
        curcar : integer;
        sursa,dest : TRect;
        bbb: TBrush;
      begin
        offscreen := TBitmap.Create;
        offscreen.Height:=ClientHeight;
        offscreen.Width:=ClientWidth;
        bbb:=offscreen.Canvas.Brush;
        bbb.Color:=FBkColor;
        offscreen.Canvas.Brush:=bbb;
        offscreen.Canvas.FillRect(ClientRect);
        offscreen.Canvas.Brush:=bbb;
        offscreen.Canvas.FrameRect(ClientRect);
        offscreen.Canvas.Brush:=Canvas.Brush;
        offscreen.Canvas.Font:=Canvas.Font;
        offscreen.Canvas.Brush.Color:=BkColor;
        Canvas.Draw(0,0,offscreen);
        //.............end base display....
        if DisplayLines=nil then exit;
        if DisplayLines.Count=0 then exit;
        textheight:=offscreen.Canvas.TextHeight('T');
        if textheight>SMILESIZE then Cursory:= ClientHeight-5-textheight
          else Cursory:= ClientHeight-5-SMILESIZE;
        i:=0;
       
        //parcurge liniile de text care se afiseaza
        line:='';
       for i:=0 to DisplayLines.Count-1 do
         begin
               Line:=DisplayLines.Strings[i];
               Cursorx:=3;
               smilenr:=0; //nr de smileuri
               minsml:=MAXINT;
                //finds smiles, deletes smiles from string and sets smilepos and smile type
                repeat
                  minsml:=MAXINT  ;
                  for j:=0 to NRSMILIES-1 do//finds first smile pos
                   begin
                   temp:=SmileCodes[j];
                   sml:=pos(temp,Line);
                   if (sml<minsml)and(sml>0) then
                            begin
                            minsml:=sml;
                            tip:=j;
                            end;
                   end;
                      if minsml<>MAXINT then//eliminates smile and ads smile to list
                       begin
                        temp:=SmileCodes[tip];
                        {Line:=}Delete(Line,minsml,Length(temp));
                        smilepos[smilenr]:=minsml-1;
                        smiletype[smilenr]:=tip;
                        inc(smilenr);
                        end;
                  until minsml<>MAXINT;
                //if no smile exist in string
                if smilenr=0 then
                 begin
                 case Line[1] of
                  '1':offscreen.Canvas.Font.Color:=FTextColor1;
                  '2':offscreen.Canvas.Font.Color:=FTextColor2;
                  '3':offscreen.Canvas.Font.Color:=FTextColor3;
                  '4':offscreen.Canvas.Font.Color:=FTextColor4;
                  '5':offscreen.Canvas.Font.Color:=FTextColor5;
                 end;
                 Delete(Line,1,1);
                 offscreen.Canvas.TextOut(Cursorx,Cursory,Line);
                 Cursorx:=3;
                 if textheight>SMILESIZE then Cursory:=Cursory-textheight else Cursory:=Cursory-SMILESIZE;
                 end
                   else
                    begin
                    //at this point the smiles should be eliminated and their
                    //positions and types stored in smilepos and smiletype
       
                    //display
                    k:=0;
                    curcar:=1;//curent caracter in string (curent substring start)
                    case Line[1] of
                          '1':offscreen.Canvas.Font.Color:=FTextColor1;
                          '2':offscreen.Canvas.Font.Color:=FTextColor2;
                          '3':offscreen.Canvas.Font.Color:=FTextColor3;
                          '4':offscreen.Canvas.Font.Color:=FTextColor4;
                          '5':offscreen.Canvas.Font.Color:=FTextColor5;
                    end;
                         Delete(Line,1,1);
                    for k:=0 to smilenr-1 do
                        begin
                        temp:=copy(Line,curcar,smilepos[k]-curcar);
                        curcar:=smilepos[k];
                        offscreen.Canvas.TextOut(Cursorx,Cursory,temp);
                        Cursorx:=Cursorx+offscreen.Canvas.TextWidth(temp);
                        dest.Left:=Cursorx;
                        if textheight>SMILESIZE then
                              dest.Top:=Cursory+(textheight-SMILESIZE) div 2
                           else
                                dest.Top:=Cursory-(textheight-SMILESIZE) div 2;
                        dest.Right:=dest.Left+SMILESIZE;
                        if dest.Right>ClientWidth-1 then dest.Right:=ClientWidth-1;
                        dest.Bottom:=dest.Top+SMILESIZE;
                        if dest.Bottom>ClientHeight-1 then dest.Bottom:=ClientHeight-1;
                        sursa.Left:=(smiletype[k]mod 5)*SMILESIZE ;
                        sursa.Top:=round((smiletype[k]/5)*SMILESIZE);
                        sursa.Right:=sursa.Left+SMILESIZE;
                        sursa.Bottom:=sursa.Top+SMILESIZE;
                        offscreen.Canvas.BrushCopy(dest,Smilies,sursa,Smilies.TransparentColor);
                        Cursorx:=Cursorx+SMILESIZE;
                        end;
                     //this displays the text after the last smile
                     temp:=copy(Line,curcar,smilepos[k]-1);
                     offscreen.Canvas.TextOut(Cursorx,Cursory,temp);
                     //end
                     Cursorx:=3;
                     if textheight>SMILESIZE then Cursory:=Cursory-textheight  else Cursory:=Cursory-SMILESIZE;
                   end;
             end;
       Canvas.Draw(0,0,offscreen);
      end;
       
      end.


    P.S. Заранее cспасибо!
    P.S.S. Если кто-либо уже такое делал, или видел в инете уже готовый компонент, пожалуйста сообщите... :)
      ну что значит "не хочет" ?
      Думаешь тут телепаты собрались или все подорвались твой текст сохранить в pas и попробовать его установить?
        Я вам не скажу за всю Одессу... Но при добавлении в юзес модуля windows начинают происходить странные вещи. Попробуй.
          2 Song: я не говорю, что тут телепаты, поэтому вот пас файл.
          "не хочет" - понимается, что он устанавливается, но в палитре компонентов не появляется.

          2 мыш: пробовал добавить Windows получаю ошифки о подмене типов, точнее отказывается работать TBitMap и точно не помню, но по-моему, еще и Canvas...

          2 All : Спасибо что откликнулись, а не бросили в беде :D
          Сообщение отредактировано: IrQX -

          Прикреплённый файлПрикреплённый файлChatEdit.pas (13.32 Кбайт, скачиваний: 355)
            Ну не могет такова быть!
            Что вкладки "CHAT" на палитре вообще нету?. А ты в конец вкладок прокручивал?
              2 ych_boriss: спасибо за издевательство! Но Обязан возразить! вкладки CHAT там нету, и прокручивать я умею :angry: я же прошу не усмехаться а помочь разобраться в этой "недокументированной" особенности... :wall:
                IrQX, извини, не хотел обидеть.
                расскажи, как устанавливал пакет.
                  IrQX, так делал? :
                  1) Install component
                  2) Compile package (если нужно)
                  3) Install package
                    2 Song: я так и делал. Обычно сразу появляется окно : "такой-то компонент - установлен!"
                    но в моем случае ничего не происходило... <_<

                    я как-то встречался с таким... но полная перепись кода испраивило этот "глюк"... щас у меня нет времени переписывать заново, к тому же не знаю: поможет ли это. Поэтому я и спрашиваю.

                    З.Ы. может это из-за перекрытия какой-либо функции (в коде) ???
                      Ты в отдельный пакет ставил?
                        Да чего вы набросились на пацана? Он действительно не ставится ни в какую ни в одтельный пакет ни просто. При этом компилируется успешно, но до тех пор, пока нет модуля Windows в uses. Вообще, такое ощущение, что это какая-то очень хитрая ошибка в модуле где-то до функции create, знаете бывает так что строку не закроешь где-нибудь в начале, а ошибка выдается в середине модуля, ругаясь на вполне законное создание какого-нибудь экземпляра. Мне кажется здесь тоже самое и лучшим методом будет пересоздать модуль и немножко покопировать текст туда-сюда.
                          Спасибо всем за поддержку и помощь!

                          Да я ставил его и в отдельный пакет и в общий - итог один.

                          2 мыш: насчет модуля Windows сказать трудно: если мне не изменяет память, то я писал компоненту и она ставилась без него. В принципе я не против его добавить, но тогда IDE начинает ругаться, на класс TBitmap и Канву (см. выше).
                            Попробуй поиграться с опциями пакета, например выстави:

                            Usage Options = Designtime and Runtime
                            Build Control = Explict rebuild

                            Это на вкладке Description опций проекта. И перекомпилируй
                              Нет, это не в пакете дело, хотя на всякий случай, поэксперементировал с опциями. А заодно с параметрами компиляции, но все равно: результат старый... <_<

                              З.Ы. Может есть еще какие-либопредложения?
                              З.Ы.Ы Заранее всем благодарен!
                                Может попробовать откомпилить код в более новой версии дельфи? Анализатор должен быть более совершенный, может найдет ошибку...
                                0 пользователей читают эту тему (0 гостей и 0 скрытых пользователей)
                                0 пользователей:


                                Рейтинг@Mail.ru
                                [ Script execution time: 0,0467 ]   [ 16 queries used ]   [ Generated: 2.12.22, 10:42 GMT ]