ychatu9.pas

来自「Yahoo Messenger for Mobile」· PAS 代码 · 共 338 行

unit YchatU9;

interface

uses
  Windows, Messages, SysUtils,  Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, ComCtrls, MyRicheditEx, DynamicSkinForm;

type
  TForm9 = class(TForm)
    Label1: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label2: TLabel;
    Label5: TLabel;
    ScrollBar1: TScrollBar;
    ScrollBar2: TScrollBar;
    ScrollBar3: TScrollBar;
    Edit1: TEdit;
    Edit2: TEdit;
    Edit3: TEdit;
    Edit4: TEdit;
    Panel1: TPanel;
    Button1: TButton;
    Button2: TButton;
    ListBox1: TListBox;
    Button3: TButton;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Button4: TButton;
    RadioButton3: TRadioButton;
    Richedit1: TMyRichEdit;
    Button5: TButton;
    procedure Panel1DblClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure ListBox1DrawItem(Control: TWinControl; Index: Integer;
      Rect: TRect; State: TOwnerDrawState);
    procedure Button2Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure ScrollBar1Change(Sender: TObject);
    procedure ScrollBar2Change(Sender: TObject);
    procedure ScrollBar3Change(Sender: TObject);
    procedure Label2DblClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button5Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
  private
    procedure UpdateFontStuff;
    { Private declarations }
  public
    procedure BuildTag;
    { Public declarations }
  end;

var
  Form9: TForm9;
  ColCode: Tcolor;

implementation

uses YchatU1, YchatU7;


{$R *.dfm}

Procedure Tform9.BuildTag;
Var
 N: Integer;
 Str: String;
begin
IF Tcols.Count>0 Then
 Begin
  Str:='';
 If Form9.RadioButton1.Checked=True Then
  CustomTag:='<FADE ';
 If Form9.RadioButton2.Checked=True Then
  CustomTag:='<ALT ';
 If Form9.RadioButton3.Checked=True Then
  CustomTag:='<ALW ';
 For N:=0 to Tcols.Count-1 do
   Begin
     CustomTag:=CustomTag+'#'+Tcols[N]+',';
   End;
  CustomTag:=Copy(CustomTag,1,Length(CustomTag)-1);
  CustomTag:=CustomTag+'>';
{  If ListBox1.Items.Count<=1 Then
   Form1.CheckBox3.Checked:=False;
  If ListBox1.Items.Count>=1 Then
   Form1.CheckBox3.Checked:=True;}
  Form9.Edit4.Text:=CustomTag;
 End;
End;




Procedure Tform9.UpdateFontStuff;
Var
 CustomTag2,BS,S,MyC,MyC2: String;
 MyColor: TColor;
 R,G,B: Integer;
begin
Try
 Form9.Richedit1.Clear;
 SetLength(BS,148);
 For R:=1 to 148 do
   BS[R]:='|';
 R:=ScrollBar1.Position;
 G:=ScrollBar2.Position;
 B:=ScrollBar3.Position;
 MyC:='$'+IntToHex(B,2)+IntToHex(G,2)+IntToHex(R,2);
 MyColor:=StringToColor(MyC);
 Label2.Color:=MyColor;
 MyC:='$'+IntToHex(R,2)+IntToHex(G,2)+IntToHex(B,2);
 Edit1.Text:=IntToStr(ScrollBar1.Position);
 Edit2.Text:=IntToStr(ScrollBar2.Position);
 Edit3.Text:=IntToStr(ScrollBar3.Position);
 MyC:='$'+IntToHex(B,2)+IntToHex(G,2)+IntToHex(R,2);
 ColCode:=StringToColor(MyC);
// Edit4.Text:='#'+copy(myc,2,length(myc)-1);
   Edit4.Text:=CustomTag;
   Form9.BuildTag;
   CustomTag2:=CustomTag;
   R:=ScrollBar1.Position;
   G:=ScrollBar2.Position;
   B:=ScrollBar3.Position;
   MyC2:='#'+IntToHex(r,2)+IntToHex(G,2)+IntToHex(b,2);
   Insert(','+MyC2,CustomTag2,Length(CustomTag2));
   If Form9.RadioButton1.Checked=True Then
     S:=Form1.BuildRTFStr(Form9.Richedit1,CustomTag2+BS+'</FADE>',Bs,'Arial',10,True,False,False,True,False);
   If Form9.RadioButton2.Checked=True Then
     S:=Form1.BuildRTFStr(Form9.Richedit1,CustomTag2+BS+'</ALT>',Bs,'Arial',10,True,False,False,True,False);
   Form1.SetSelectionRtf(Form9.richedit1,S);
   Form1.SortCustomTag;
  Except
 End;
End;
 //BUG BUG BUG

procedure TForm9.Panel1DblClick(Sender: TObject);
Var
 S: String;
 R,G,B: Integer;
begin
 InputQuery('Type in Colour Code (EG #EAEAEA)','Hex Code',S);
 If (Length(S)>0) and (S[1]='#') and (Length(S)=7)  Then
  Begin
   Try
    R:=StrToInt('$'+Copy(S,2,2));
    G:=StrToInt('$'+Copy(S,4,2));
    B:=StrToInt('$'+Copy(S,6,2));
    ScrollBar1.Position:=R;
    ScrollBar2.Position:=G;
    ScrollBar3.Position:=B;
     Except
   End;  
  End
   else
  ShowMessage('Invalid Colour Code');
end;

procedure TForm9.Button1Click(Sender: TObject);
Var
 N: Integer;
 MyC,MyC2,Str: String;
 R,G,B: Integer;
begin
form9.UpdateFontStuff;
  Str:='';
 For N:=1 to 85 Do
  Str:=Str+'|';
 ListBox1.Items.Add(Str);
 R:=ScrollBar1.Position;
 G:=ScrollBar2.Position;
 B:=ScrollBar3.Position;
 MyC2:='$'+IntToHex(r,2)+IntToHex(G,2)+IntToHex(b,2);
 MyC:='$'+IntToHex(B,2)+IntToHex(G,2)+IntToHex(R,2);
 Delete(MyC,1,1);
 Delete(MyC2,1,1);
 Tcols.Add(MyC2);
 // //<FADE #ff0000,#00ff00,#0000ff>hello</FADE>
  Form1.SortCustomTag;
  form9.UpdateFontStuff;
end;

procedure TForm9.FormCreate(Sender: TObject);
Var
 Str: String;
 R,N: Integer;
begin
For R:=0 to Tcols.Count-1 do
 Begin
   For N:=1 to 85 Do
    Str:=Str+'|';
   ListBox1.Items.Add(Str);
 End;
  Form1.SortCustomTag;
  form9.UpdateFontStuff;
end;

procedure TForm9.Button3Click(Sender: TObject);
begin
 Tcols.SaveToFile(Path+'Fade.Txt');
 Close;
end;

procedure TForm9.ListBox1DrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
Var
 N: Integer;
begin
   with listBox1 do begin
//     0: Canvas.Font.Color := StringToColor(Tcols[0]);
   For N:=0 to Tcols.Count-1 do
    Begin
      If N=Index Then
       Begin
         Canvas.Font.Color := Form1.ReverseColor(Tcols[N]);
       End;
    End;

 Canvas.TextRect(Rect, Rect.Left, Rect.Top, Items.Strings[Index]);
 end;
end;

procedure TForm9.Button2Click(Sender: TObject);
Var
 R,N: Integer;
begin
form9.UpdateFontStuff;
R:=-1;
 For N:=0 to ListBox1.Items.Count-1  do
   Begin
     If ListBox1.Selected[N] Then
       R:=N;
   End;
 If R<>-1 Then
  Begin
   Tcols.Delete(R);
   ListBox1.Items.Delete(R);
  End;
If Form9.RadioButton1.Checked=True Then
  Form1.SortCustomTag;
 form9.UpdateFontStuff;
end;

procedure TForm9.Button4Click(Sender: TObject);
begin
 ListBox1.Clear;
 Tcols.Clear;
 form9.UpdateFontStuff
end;

procedure TForm9.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose:=True;
 IF Listbox1.Items.Count<=1 Then
  Begin
   ShowMessage('You need at least two colors in the fader to work with');
   CanClose:=False;
  End;
end;

procedure TForm9.ScrollBar1Change(Sender: TObject);
begin
form9.UpdateFontStuff;
end;

procedure TForm9.ScrollBar2Change(Sender: TObject);
begin
form9.UpdateFontStuff;
end;

procedure TForm9.ScrollBar3Change(Sender: TObject);
begin
form9.UpdateFontStuff;
end;

procedure TForm9.Label2DblClick(Sender: TObject);
begin
 RadioButton3.Enabled:=True;
end;

procedure TForm9.FormClose(Sender: TObject; var Action: TCloseAction);
begin
 Form9.BuildTag;
end;

procedure TForm9.Button5Click(Sender: TObject);
Var
 R,R2,N: Integer;
 Str,MyC,MyC2: String;
begin
form9.UpdateFontStuff;
R:=-1;
 For N:=ListBox1.Items.Count-1  downto 0 do
   Begin
     If ListBox1.Selected[N]=True Then
      Begin
       R2:=N;
       Break;
      End;
   End;
 If R2<>-1 Then
  Begin
   For N:=1 to 85 Do
     Str:=Str+'|';
   R:=ScrollBar1.Position;
   G:=ScrollBar2.Position;
   B:=ScrollBar3.Position;
   MyC2:='$'+IntToHex(r,2)+IntToHex(G,2)+IntToHex(b,2);
   MyC:='$'+IntToHex(B,2)+IntToHex(G,2)+IntToHex(R,2);
   Delete(MyC,1,1);
   Delete(MyC2,1,1);
   Tcols.Insert(R2,MyC2);
   ListBox1.Items.Insert(R2,Str);
  End;
If Form9.RadioButton1.Checked=True Then
  Form1.SortCustomTag;
 form9.UpdateFontStuff;
end;

procedure TForm9.RadioButton1Click(Sender: TObject);
begin
form9.UpdateFontStuff;
end;

procedure TForm9.RadioButton2Click(Sender: TObject);
begin
form9.UpdateFontStuff;
end;

end.